SuperHack/SuperHack CD.bin/CODING/DELPHI/DELPHCGI.ZIP/CGI.ZIP/SAMPLES/FORM/PIZZFORM.PAS

Pascal/Delphi Source File | 1995-07-17 | 4.6 KB | 163 lines

unit PizzForm;

{  Application: PIZZAD.DPR
         Author: Michael B. Klein <[e-mail]>
           Date: May 16, 1995

    Sample CGI back-end using the TCGI component.  Based on the Visual Basic
    sample CGI app PIZZA.BAS, which is supplied with Windows httpd.

    Thanks to Robert B. Denny for Windows httpd and Windows CGI, and for his help
    getting me around a pretty sticky applcation design issue.  }

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, CGI, CGIDlg;

type
  TMainForm = class(TForm)
     CGI: TCGI;
     CGIDlg: TCGIDlg;
     procedure SendOrderForm;
     procedure ProcessOrder;
     procedure FormCreate(Sender: TObject);
  private
     { Private declarations }
     procedure SendHeader(const Title: String);
     procedure SendFooter;
     procedure RejectOrder(const Reason: String);
  public
     { Public declarations }
  end;

const
    crlf: String = #13#10;

var
  MainForm: TMainForm;

implementation

{$R *.DFM}

procedure TMainForm.SendOrderForm;
begin
    with CGI do begin
        SendHeader('Pizza Order Form');
        Send('<FORM METHOD="POST" ACTION="/cgi-win/pizzad.exe">');
        Send('<B>Godzilla''s Pizza -- Internet Delivery Service</B><P>');
        Send('At present, we accept internet orders only for medium (13") size pizzas.');
        Send('It is now ' + FormatDateTime('h:mm AM/PM', Now) +'. ');
        Send('You will have your pizza by ' + FormatDateTime('h:mm AM/PM', Now + EncodeTime(0,45,0,0)) + '.');
        Send('<PRE>');
        Send('          Name: <INPUT SIZE=30 NAME="name">'+crlf);
        Send('Street address: <INPUT SIZE=30 NAME="address">'+crlf);
        Send('  Phone number: <INPUT SIZE=15 NAME="phone">'+crlf);
        Send('          City: <SELECT NAME="city">');
        Send('                <OPTION SELECTED>Pasadena (free)');
        Send('                <OPTION>Altadena (free)');
        Send('                <OPTION>So. Pasadena ($1.00)');
        Send('                <OPTION>Arcadia ($1.00)');
        Send('                <OPTION>Monrovia ($2.50)');
        Send('                </SELECT>'+crlf);
        Send('</PRE>');
        Send('Which toppings would you like? <BR>');
        Send('<OL>');
        Send('<LI> <INPUT TYPE="checkbox" NAME="topping" VALUE="pepperoni"> Pepperoni.');
        Send('<LI> <INPUT TYPE="checkbox" NAME="topping" VALUE="sausage"> Sausage.');
        Send('<LI> <INPUT TYPE="checkbox" NAME="topping" VALUE="anchovies"> Anchovies.');
        Send('</OL>');
        Send('To order your pizza, press this button: <INPUT TYPE="submit" VALUE="Order Pizza">.');
        Send('</FORM>');
    end;
    SendFooter;
end;

procedure TMainForm.ProcessOrder;
var
    Cust,
   Address,
    City,
    Phone,
    Toppings: String;
    i: Char;
begin
    with CGI.FormFields do begin
        Cust := Values['name'];
        Address := Values['address'];
        Phone := Values['phone'];
        City := Values['city'];
        Toppings := Values['topping'];

        i := '1';
        while IndexOfKey('topping_'+i) > -1 do begin
            Toppings := Toppings + ', ' + Values['topping_'+i];
            Inc(i);
        end;
    end;

    if (Cust = '') or (Address = '') or (Phone = '') or (City = '') then
        RejectOrder('you didn''t fill in all of the fields')
    else begin
        SendHeader('Order Confirmation');
        with CGI do begin
            Send('<H1>Order Confirmation</H1>');
            Send('Your order has been received, and appears valid. Here it is:');
            Send('<PRE>');
            Send('          Name: ' + Cust+crlf);
            Send('Street address: ' + Address+crlf);
            Send('  Phone number: ' + Phone+crlf);
            Send('          City: ' + City+crlf);
            Send('      Toppings: ' + Toppings+crlf);
            Send('</PRE>');
            Send('If you have any corrections, please call 555-555-5555 immediately!');
        end;
        SendFooter;
    end;
end;

procedure TMainForm.SendHeader(const Title: String);
begin
    with CGI do begin
        Send('<HTML><HEAD><TITLE>' + Title + '</TITLE></HEAD>');
        Send('<BODY>');
    end;
end;

procedure TMainForm.SendFooter;
begin
    with CGI do begin
        Send('<HR>');
        Send('Click below to send mail to our order desk:<BR>');
        Send('<A HREF="mailto:[e-mail]">');
        Send('<ADDRESS><[e-mail]></ADDRESS></A>');
        Send('</BODY></HTML>');
    end;
end;

procedure TMainForm.RejectOrder(const Reason: String);
begin
    SendHeader('Order Rejected');
    with CGI do begin
       ServerStatus := stBadRequest;
        Send('<H1>Can''t process your order</H1>');
        Send('We can''t process your order because ' + Reason + '. ');
        Send('Please correct your order and re-send it.');
    end;
    SendFooter;
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
    case CGI.Method of
        rmGet: SendOrderForm;
        rmPost: ProcessOrder;
    end;
   if CGI.Profile.DebugMode then CGIDlg.Execute;
   Application.Terminate;
end;

end.